返信時引用編集スクリプト

# 電信八号本体のバージョンアップにより、プレーンテキスト抽出機能が
# 標準装備されるようになりました。そのため、拙作「マルチパート部分
# 除去スクリプト」のメイン機能が不要になりましたので(苦笑)、おま
# け機能のみのスクリプトにしてみました。
# バージョンが321.2b6-stable以前の場合は、従来の「reply.pl」の方を
# お使い下さい。

動作内容:

・引用の引用(の引用(...))‘> >’を‘>>’に変換する
・「≫,》,>,】,}」の各文字を‘>’に変換する
・「xxxxx> 〜」形式の名前入り引用符を‘>’のみに変換する
・空白行から引用符を除去する
・メイル本文が、‘confirm’で始まる場合、引用符を付けずにその行のみ
 を引用するようにする(fmlサブスクライブ用)←めちゃくちゃ横着者!!
・おまけ:件名部分の「Re(x):〜」「Re*x:〜」「Re[X]:〜」を電信八号の
 $RECOMMENDED-SUBJECT形式「Re^x:〜」に変換する機能を付けました。引
 数の先頭行に「Subject:〜」の形式を記述すると、%%RETx-2に整形後の
 文字列を返します

動作確認環境:

 電信八号(V321.2a71以降で確認しています)
 Jdate(Ver.3.02以降で確認しています)
 Perlが動作する環境

使用方法:

 1.下のスクリプトをコピーし、適当な名前で保存する
    例:reply2.pl
 2.返信用テンプレートにスクリプト呼び出しを記述する
    例:(パスは必要に応じてご変更ください)
    |%%RET1-1
    |%DATA 1,perl %JDATE%reply2.pl,%FILE
    |%DISABLE
    |$QUOTED-BODY
    |%ENABLE
    |%END

判っている不具合および改善を要す箇所:

 名前入り引用符の判定が完全でないため、引用を余計に除去してしまう
 可能性があります

謝辞:

 最後になりましたが、電信八号を開発された石岡さんと電八倶楽部のみ
 なさん、Jdateを開発された浅野さんにこの場を借りてお礼申し上げます。
 いつも便利に使用させて頂き、ありがとうございます。こんな素晴らし
 いソフトをフリーで公開して下さっているなんて、本当に感激です。

付録:

 電信八号オフィシャルサイト http://denshin8.esprix.net/
 浅野さんのホームページ http://user.shikoku.ne.jp/~asanonao/


以上です。拙文をわざわざお読み頂き、ありがとうございました。

-- 
Osamu Ogawa / 小川 修
mailto:jikoman@ogawa.8k.com

# reply2t.pl 2000-11-30
open(INI,&dchange($ARGV[0]));
@lines=<INI>;
close(INI);
$cur=shift(@lines);
if ($cur=~/^subject: (.*\n)/i) {
    $ret=$1; $rec=0;
    for (;;) {
        if ($ret=~/^re:\s*(.*\n)/i) {
            $ret=$1; $rec++;
        } elsif ($ret=~/^re[\^\*](\d+):\s*(.*\n)/i) {
            $ret=$2; $rec+=$1;
        } elsif ($ret=~/^re[\[\(](\d+)[\]\)]:\s*(.*\n)/i) {
            $ret=$2; $rec+=$1; 
        } else {
            last;
        }
    }
    if ($rec > 1) {
        $cur="Subject: Re^".$rec.": ".$ret;
    }
    push (@sub,"%DIVISION\n");
    push (@sub,$cur);
} else {
    unshift (@lines,$cur);
}
push (@sub,"%EOF\n");
for(;;){
    $cur=&pscut(shift(@lines));
    if ($cur ne "\n") {
        last;
    }
}
for(;;){
    if (!$cur) {
        last;
    }
    if (&small($cur)=~/^> confirm /) {
        # push(@new,substr($cur,2));
        @new=substr($cur,2);
        last;
    }
    push(@new,$cur);
    $cur=&pscut(shift(@lines));
}
for(;;){
    $cur=pop(@new);
    if ($cur ne "\n") {
        last;
    }
}
open(OUT,"> ".&dchange($ARGV[1]));
print OUT @new;
print OUT $cur;
print OUT @sub;
close(OUT);
exit;
sub dchange {
    my($a)=@_;
    $a=~s/\\/\//g;
    $a;
}
sub pscut {
    my($a)=@_; my($b)=""; my($c)="";
    for (;;) {
        $lspa=$a;
        $lspa=~s/^(\s*).*\n/$1/;
        $a=~s/^\s*(.*\n)/$1/;
        unless ($a) {last; }
        if ($a eq "\n") {last; }
        foreach $c (">","≫","》",">","】","}") {
            $lind=length($c);
            if ($c eq substr($a,0,$lind)) {
                last;
            }
            $lind=0;
        }
        if ($lind) {
            $a=substr($a,$lind);
            $b.=">";
            redo;
        }
        if ($lspa=~/^\s\s+/) { last; }
        $lind=index($a,">");
        if ($lind<0) {last; }
        $c=substr($a,0,$lind);
        if ($c=~/[\s<\(\)]/) {last; }
        $a=substr($a,$lind);
    }
    # if (length($lspa)<2) {$lspa=" "; }
    unless ($lspa) {$lspa=" "; }
    if ($b) {$a=$b.$lspa.$a; }
    $a=~s/\s+\n/\n/;
    $a=~s/^>+\n/\n/;
    $a;
}
sub small {
    my($a)=@_;
    $a=~tr/A-Z/a-z/;
    $a;
}

まえにもどる